Day 4:★★（二つ星）オープンデータ
Rスクリプト
スクリプトエディタを用いると コンソールにスクリプトを入力する場合と比較して作業効率がアップします． それではさっそくスクリプトエディタを使ってみましょう．
スクリプトエディタの起動
Rを起動します．
メニューの[ファイル]を開き，[新しいスクリプト]をクリックします．
スクリプトエディタに下記スクリプトを入力します．
library(ggplot2)
g<-ggplot(iris,aes(x=Sepal.Length,y=Sepal.Width,color=Species))
g<-g+geom_point()
g
Rスクリプトの実行
つぎに入力したスクリプトを実行します． メニュー[編集]を開き，[全て実行]をクリックします．
するとコンソールにスクリプトが入力され， グラフが表示されます．
Rスクリプトの編集
スクリプトの一部を変更します．ここでは回帰直線を追加します．
library(ggplot2)
g<-ggplot(iris,aes(x=Sepal.Length,y=Sepal.Width,color=Species))
g<-g+geom_point()+geom_smooth(method="lm")
g
変更後のスクリプトを実行します．
メニュー[編集]を開き，[全て実行]をクリックします．
コンソールにスクリプトが入力され， グラフが表示されます．
追加した回帰直線がちゃんと描画されています．
Rスクリプトの保存
ファイルにスクリプトを保存します． メニュー[ファイル]を開き，[保存]をクリックします．
保存ダイアログが表示されます．
適当な名前を付けて（ここでは hoge.r とする）保存します．
スクリプトの保存に成功すると， タイトルバーに保存したファイルのフルパスが表示されます．
Rスクリプトの読み込み
保存したRスクリプトを読み込みます．
メニューの[ファイル]を開き[スクリプトを開く]をクリックします．
メニュー[編集]を開き，[全て実行]をクリックします．
コンソールにスクリプトが入力され， グラフが表示されます．追加した回帰直線も描画されています．
★★（二つ星）オープンデータ
「★★（二つ星）オープンデータ」とは「5 Star OPEN DATA」の第二段階にあたるデータです． オープンライセンス(Open License;OL)での公開に加え， 読み込み可能（Readable;RE）なデータであることが条件となります．
Star OPEN DATA」
「★★（二つ星）オープンデータ」の代表例はExcelファイルです． Excelファイルのデータであれば，Excelを用いてのデータ処理が可能となります． 前回の演習のように，PDFファイルからテキストを抽出し，整形してから処理するといった手間が不要となります．
それでは「★★（二つ星）オープンデータ」のデータ処理に取り組んでいきましょう．
「★★（二つ星）オープンデータ」の可視化：統計局データ
本演習では総務省統計局が公開する「日本の統計2016」の人口推移データを可視化します．
データの入手
総務省統計局のホームページから人口推移データをダウンロードします．
総務省統計局のホームページ（ http://www.stat.go.jp/index.htm ）にアクセスします．
[統計データ]>[日本の統計]>[本書の内容]の順番にリンクを辿ります．
[第2章 人口・世帯]のリンクをクリックし、[2- 1 人口の推移と将来人口（エクセル：40KB）]をダウンロードします．
ダウンロードしたファイルをRの作業ディレクトリに設置します．
作業ディレクトリが不明な場合は，Rのコンソール画面に下記コマンドを入力して下さい． 作業ディレクトリのフルパスが表示されます．
getwd()これでデータ処理の準備が整いました．
それと蛇足とはなりますが，予めデータの所在地（URL）がわかっている場合はRから直接ファイルをダウンロードすることができます．
download.file(url="http://www.stat.go.jp/data/nihon/zuhyou/n160200100.xls",destfile = "n160200100.xls")これだけでファイルのダウンロードが完了します．
データの読み込み
if(!require(xlsx)){
install.packages("xlsx")
library(xlsx)
}
if(!require(reshape2)){
install.packages("reshape2")
library(reshape2)
}
if(!require(ggplot2)){
install.packages("ggplot2")
library(ggplot2)
}
#游ゴシック体を使う
if(.Platform$OS.type=="windows")
windowsFonts(yugo=windowsFont("Yu Gothic"))
if(capabilities("aqua"))
quartzFonts(yugo=quartzFont(rep("YuGo-Medium",4)))
tbl <- read.xlsx("n160200100.xls",sheetIndex = 1)
head(tbl)## 第２章..人口.世帯.......... NA. NA..1 NA..2 NA..3 NA..4
## 1 <NA> NA <NA> <NA> <NA> <NA>
## 2 <NA> NA <NA> <NA> <NA> <NA>
## 3 年次 NA <NA> 総人口（1,000人） <NA> <NA>
## 4 <NA> NA <NA> 総数 男 女
## 5 <NA> NA <NA> <NA> <NA> <NA>
## 6 <NA> NA <NA> <NA> <NA> <NA>
## NA..5 NA..6 NA..7 NA..8
## 1 <NA> <NA> <NA> <NA>
## 2 <NA> <NA> <NA> <NA>
## 3 人口増減 （1,000人） 1) <NA> <NA> <NA>
## 4 増減数 2) 自然増減 <NA>
## 5 <NA> <NA> 出生児数 死亡者数
## 6 <NA> <NA> <NA> <NA>
## NA..9 NA..10
## 1 2－1 人 口 の 推 移 と 将 来 人 口
## 2 <NA> <NA>
## 3 <NA> 対前年\n増減率\n（人口1,000につき）
## 4 社会増減 <NA>
## 5 <NA> <NA>
## 6 <NA> <NA>
## NA..11 NA..12
## 1 <NA> <NA>
## 2 <NA> <NA>
## 3 人口密度\n\n（人／km2） 年齢3区分別人口（1,000人） 3)
## 4 <NA> 0～14歳\n(年少\n人口)
## 5 <NA> <NA>
## 6 <NA> <NA>
## NA..13 NA..14
## 1 <NA> <NA>
## 2 <NA> <NA>
## 3 <NA> <NA>
## 4 15～64\n（生産年齢\n人口） 65歳以上\n（老年\n人口）
## 5 <NA> <NA>
## 6 <NA> <NA>
## NA..15 NA..16
## 1 <NA> <NA>
## 2 <NA> <NA>
## 3 年齢3区分別人口構成比（%）4) <NA>
## 4 0～14歳（年少\n人口） 15～64（生産年齢人口）
## 5 <NA> <NA>
## 6 <NA> <NA>
## NA..17 NA..18 NA..19 NA..20 NA..21
## 1 <NA> NA <NA> NA <NA>
## 2 <NA> NA <NA> NA <NA>
## 3 <NA> NA 年次 NA <NA>
## 4 65歳以上\n（老年\n人口） NA <NA> NA <NA>
## 5 <NA> NA <NA> NA <NA>
## 6 <NA> NA <NA> NA <NA># 必要な場所だけを取り出す
tbl<-tbl[7:44,4:6]
tbl<-tbl[c(-6,-28),]
(tbl<-cbind(tbl,year=c(1920,1925,1930,1935,1940,1950,1955,1960,1965,1970,1975,1980,1985,1990,1995,2000,2005,2006,2007,2008,2009,2010,2011,2012,2013,2014,2020,2025,2030,2035,2045,2055,2065,2075,2085,2095)))## NA..2 NA..3 NA..4 year
## 7 55963 28044 27919 1920
## 8 59737 30013 29724 1925
## 9 64450 32390 32060 1930
## 10 69254 34734 34520 1935
## 11 71933 35387 36546 1940
## 13 84115 41241 42873 1950
## 14 90077 44243 45834 1955
## 15 94302 46300 48001 1960
## 16 99209 48692 50517 1965
## 17 104665 51369 53296 1970
## 18 111940 55091 56849 1975
## 19 117060 57594 59467 1980
## 20 121049 59497 61552 1985
## 21 123611 60697 62914 1990
## 22 125570 61574 63996 1995
## 23 126926 62111 64815 2000
## 24 127768 62349 65419 2005
## 25 127901 62387 65514 2006
## 26 128033 62424 65608 2007
## 27 128084 62422 65662 2008
## 28 128032 62358 65674 2009
## 29 128057 62328 65730 2010
## 30 127799 62184 65615 2011
## 31 127515 62029 65486 2012
## 32 127298 61909 65388 2013
## 33 127083 61801 65282 2014
## 35 124100 60146 63954 2020
## 36 120659 58337 62322 2025
## 37 116618 56253 60364 2030
## 38 112124 53980 58144 2035
## 39 102210 49131 53079 2045
## 40 91933 44140 47794 2055
## 41 81355 38935 42420 2065
## 42 70689 33901 36788 2075
## 43 61434 29515 31919 2085
## 44 53322 25585 27737 2095colnames(tbl)<-c("total","male","female","year")
tbl## total male female year
## 7 55963 28044 27919 1920
## 8 59737 30013 29724 1925
## 9 64450 32390 32060 1930
## 10 69254 34734 34520 1935
## 11 71933 35387 36546 1940
## 13 84115 41241 42873 1950
## 14 90077 44243 45834 1955
## 15 94302 46300 48001 1960
## 16 99209 48692 50517 1965
## 17 104665 51369 53296 1970
## 18 111940 55091 56849 1975
## 19 117060 57594 59467 1980
## 20 121049 59497 61552 1985
## 21 123611 60697 62914 1990
## 22 125570 61574 63996 1995
## 23 126926 62111 64815 2000
## 24 127768 62349 65419 2005
## 25 127901 62387 65514 2006
## 26 128033 62424 65608 2007
## 27 128084 62422 65662 2008
## 28 128032 62358 65674 2009
## 29 128057 62328 65730 2010
## 30 127799 62184 65615 2011
## 31 127515 62029 65486 2012
## 32 127298 61909 65388 2013
## 33 127083 61801 65282 2014
## 35 124100 60146 63954 2020
## 36 120659 58337 62322 2025
## 37 116618 56253 60364 2030
## 38 112124 53980 58144 2035
## 39 102210 49131 53079 2045
## 40 91933 44140 47794 2055
## 41 81355 38935 42420 2065
## 42 70689 33901 36788 2075
## 43 61434 29515 31919 2085
## 44 53322 25585 27737 2095tbl$total <- as.numeric(as.character(tbl$total))
tbl$male <- as.numeric(as.character(tbl$male))
tbl$female <- as.numeric(as.character(tbl$female))
tmp <- melt(tbl,id=c("year","total"))
head(tmp)## year total variable value
## 1 1920 55963 male 28044
## 2 1925 59737 male 30013
## 3 1930 64450 male 32390
## 4 1935 69254 male 34734
## 5 1940 71933 male 35387
## 6 1950 84115 male 41241棒グラフの描画
ggplot(tmp,aes(x=year,y=value,group=variable,fill=variable))+geom_bar(stat = "identity")
ggplot(tmp,aes(x=year,y=value,group=variable,fill=variable))+geom_bar(stat = "identity",position="dodge")
折れ線グラフの描画
ggplot(tmp,aes(x=year,y=value,group=variable,color=variable))+geom_line()
ggplot(tmp,aes(x=year,y=value,group=variable,color=variable))+geom_line()+geom_vline(aes(xintercept=2016))
max_female<-max(tbl$female)
ggplot(tmp,aes(x=year,y=value,group=variable,color=variable))+geom_line()+geom_vline(aes(xintercept=2016))+geom_hline(aes(yintercept=max_female))
ggplot(tmp,aes(x=year,y=value,group=variable,color=variable))+geom_line()+geom_vline(aes(xintercept=2016),linetype="dashed")+geom_hline(aes(yintercept=max_female),linetype="dashed")
面グラフの描画
ggplot(tmp,aes(x=year,y=value,group=variable,fill=variable))+geom_area()+geom_vline(aes(xintercept=2016),linetype="dashed")
if(!require(scales)){
install.packages("scales")
library(scales)
}
ggplot(tmp,aes(x=year,y=value,group=variable,fill=variable))+geom_area()+geom_vline(aes(xintercept=2016),linetype="dashed")+ scale_y_continuous(labels=comma) 
ggplot(tmp,aes(x=year,y=value,group=variable,fill=variable))+geom_area()+geom_vline(aes(xintercept=2016),linetype="dashed")+ scale_y_continuous(labels=comma) +geom_line(aes(y=total))
注釈の追加
ggplot(tmp,aes(x=year,y=total))+geom_bar(stat="identity")
ggplot(tmp,aes(x=year,y=total))+geom_line()
peak_value<-max(tbl$total)
ggplot(tmp,aes(x=year,y=total))+geom_line()+geom_vline(aes(xintercept=2016),linetype="dashed")+geom_hline(aes(yintercept=peak_value),color="red")
tbl[tbl$total==peak_value,]## total male female year
## 27 128084 62422 65662 2008peak_year<-tbl[tbl$total==peak_value,]$year
ggplot(tmp,aes(x=year,y=total))+geom_line()+geom_vline(aes(xintercept=2016),linetype="dashed")+geom_hline(aes(yintercept=peak_value),color="red")+annotate("text",label=paste("peak(",peak_year,",",peak_value,")"),x=peak_year,y=peak_value,color="red",size=3)
ggplot(tmp,aes(x=year,y=total))+geom_line()+geom_vline(aes(xintercept=2016),linetype="dashed")+geom_hline(aes(yintercept=peak_value),color="red")+annotate("text",label=paste("peak(",peak_year,",",peak_value,")"),x=peak_year,y=peak_value+1000,color="red",size=3)
ggplot(tmp,aes(x=year,y=total))+geom_line()+geom_vline(aes(xintercept=2016),linetype="dashed")+annotate("text",label=paste("peak(",peak_year,",",peak_value,")"),x=peak_year,y=peak_value+1000,color="red",size=3)
軸ラベル
ggplot(tmp,aes(x=year,y=value,color=variable))+geom_line()
ggplot(tmp,aes(x=year,y=value,color=variable))+geom_line()+ylab("人口")+theme_gray(base_family ="yugo")
ggplot(tmp,aes(x=year,y=value,color=variable))+geom_line()+xlab("年")+theme_gray(base_family ="yugo")
ggplot(tmp,aes(x=year,y=value,color=variable))+geom_line()+ylab("人口")+xlab("年")+theme_gray(base_family ="yugo")
軸目盛り
g<-ggplot(tmp,aes(x=year,y=value,color=variable))+geom_line()+ylab("人口")+xlab("年")+theme_gray(base_family ="yugo")
g
g<-g + scale_y_continuous(breaks=seq(0,80000,by=20000),limits = c(0,80000))
g
g<-g+scale_x_continuous(breaks = seq(1900,2100,by=50),limits = c(1900,2100))
g
凡例
ggplot(tmp,aes(x=year,y=value,color=variable))+geom_line()
ggplot(tmp,aes(x=year,y=value,color=variable))+geom_line()+scale_color_hue(name = "性別", labels = c(male = "男性", female = "女性"))+theme_gray(base_family ="yugo")
ggplot(tmp,aes(x=year,y=value))+geom_line(aes(lty=variable))
ggplot(tmp,aes(x=year,y=value))+geom_line(aes(lty=variable))+scale_linetype(name = "性別", labels = c(male = "男性", female = "女性"))+theme_gray(base_family ="yugo")
ggplot(tmp,aes(x=year,y=value,fill=variable))+geom_area()
ggplot(tmp,aes(x=year,y=value,fill=variable))+geom_area()+scale_fill_hue(name = "性別", labels = c(male = "男性", female = "女性"))+theme_gray(base_family ="yugo")
日本の人口
if(!require(xlsx)){
install.packages("xlsx")
library(xlsx)
}
if(!require(reshape2)){
install.packages("reshape2")
library(reshape2)
}
if(!require(ggplot2)){
install.packages("ggplot2")
library(ggplot2)
}
#游ゴシック体を使う
if(.Platform$OS.type=="windows")
windowsFonts(yugo=windowsFont("Yu Gothic"))
if(capabilities("aqua"))
quartzFonts(yugo=quartzFont(rep("YuGo-Medium",4)))
tbl <- read.xlsx("n160200100.xls",sheetIndex = 1)
tbl<-tbl[7:44,4:6]
tbl<-tbl[c(-6,-28),]
tbl<-cbind(tbl,year=c(1920,1925,1930,1935,1940,1950,1955,1960,1965,1970,1975,1980,1985,1990,1995,2000,2005,2006,2007,2008,2009,2010,2011,2012,2013,2014,2020,2025,2030,2035,2045,2055,2065,2075,2085,2095))
colnames(tbl)<-c("total","male","female","year")
tbl$total <- as.numeric(as.character(tbl$total))
tbl$male <- as.numeric(as.character(tbl$male))
tbl$female <- as.numeric(as.character(tbl$female))
tmp <- melt(tbl,id=c("year","total"))
g<-ggplot(tmp,aes(x=year,y=value,group=variable,fill=variable))
g<-g+geom_area()
g<-g+geom_vline(aes(xintercept=2016),linetype="dashed")
g<-g+scale_y_continuous(labels=comma)
g<-g+annotate("text",label=paste("peak(",peak_year,",",peak_value,")"),x=peak_year,y=peak_value+1000,color="red",size=3)
g<-g+ggtitle("日本の人口推移（予想）")+ylab(label = "人口(千人)")+xlab("年")+theme_gray(base_family ="yugo")
g<-g+scale_fill_hue(name = "性別", labels = c(male = "男性", female = "女性"))
g<-g+scale_y_continuous(breaks=seq(0,150000,by=25000),limits = c(0,150000))
g<-g+scale_x_continuous(breaks = seq(1900,2100,by=50),limits = c(1900,2100))
g
ggsave("ex01.png",plot = g)課題
統計局の世界の統計にある人口データを可視化してください．
データ入手場所：
[統計データ]>[世界の統計]>[本書の内容]>[第2章 人口]>[2-1 世界人口の推移（1950～2050年） （エクセル：614KB）]
1)地域別人口推移の可視化
dat<-read.xlsx("02.xls",sheetIndex = 2)
tbl2<-dat[4:40,1:8]
colnames(tbl2)<-c("Year","World","Asia","NorthAmerica","SouthAmerica","Europe","Africa","Oceania")
tbl2$Year<-as.numeric(as.character(tbl2$Year))
tbl2$World<-as.numeric(as.character(tbl2$World))
tbl2$Asia<-as.numeric(as.character(tbl2$Asia))
tbl2$NorthAmerica<-as.numeric(as.character(tbl2$NorthAmerica))
tbl2$SouthAmerica<-as.numeric(as.character(tbl2$SouthAmerica))
tbl2$Europe<-as.numeric(as.character(tbl2$Europe))
tbl2$Africa<-as.numeric(as.character(tbl2$Africa))
tbl2$Oceania<-as.numeric(as.character(tbl2$Oceania))
tmp<-melt(tbl2,id=c("Year","World"))
ggplot(tmp,aes(x=Year,y=value,group=variable,color=variable))+geom_line()
g<-ggplot(tmp,aes(x=Year,y=value,group=variable,fill=variable))+geom_area()
g
g<-g+scale_fill_hue(name = "地域", labels = c(Asia="アジア",NorthAmerica="北アメリカ",SouthAmerica="南アメリカ",Europe="ヨーロッパ",Africa="アフリカ",Oceania="オセアニア"))+theme_gray(base_family ="yugo")
g
g<-g+ggtitle("地域別世界人口推移")+ylab("人口（百万人）")+xlab("年")
g
2)人口比率（先進国・開発途上国)
tbl3<-dat[4:40,c(1:2,9:10)]
colnames(tbl3)<-c("year","world","advanced","developed")
tbl3$year <- as.numeric(as.character(tbl3$year))
tbl3$world <- as.numeric(as.character(tbl3$world))
tbl3$advanced <- as.numeric(as.character(tbl3$advanced))
tbl3$developed <- as.numeric(as.character(tbl3$developed))
tmp <- melt(tbl3,id=c("year","world"))
ggplot(tmp,aes(x=year,y=value,group=variable,color=variable))+geom_line()
g<-ggplot(tmp,aes(x=year,y=value,group=variable,fill=variable))+geom_area()
g<-g+ggtitle("人口比率")+ylab("人口比率（%）")+xlab("年")+theme_gray(base_family ="yugo")
g<-g+scale_fill_hue(name = "", labels =c(advanced="先進国",developed="発展途上国"))
g
(発展)
tbl4<-tbl3
tbl4$advanced<-(tbl4$advanced/100)*tbl4$world
tbl4$developed<-(tbl4$developed/100)*tbl4$world
tmp <- melt(tbl4,id=c("year","world"))
g<-ggplot(tmp,aes(x=year,y=value,group=variable,fill=variable))+geom_area()
g<-g+ggtitle("人口推移")+ylab("人口（百万人）")+xlab("年")+theme_gray(base_family ="yugo")
g<-g+scale_fill_hue(name = "", labels =c(advanced="先進国",developed="発展途上国"))
g